HPAVC

home *** CD-ROM | disk | FTP | other *** search

/ HPAVC / HPAVC CD-ROM.iso / pc / C2SND201.ZIP / CONV2SND.PAS < prev next >

Wrap

Pascal/Delphi Source File | 1994-06-20 | 35.9 KB | 947 lines

(* Convert to Deskmate Sound, version 2.00 PUBLIC DOMAIN Kenneth Udut January 14 - 27, 1993 [Modified with the author's permission by Jeffrey L. Hayes, June 14-22, 1994. The code has been beautified and minor modifications done to make it work on Turbo Pascal version 5, which is what I have - Ken has TP6. The filesize bug in version 1.98 of this program has been corrected. This version also allows the user to specify the output filename. The default is now to use the input filename and attach an .snd extension. This version adds support for Windows .wav files. - J.L. Hayes] PURPOSE: This program converts any 8-bit PCM digitized sound into a DeskMate Sound file. It will allow you to use Deskmate's SOUND program to edit these files. My thanks to Christopher Taveres for his program SOUNDOFF, written for the Tandy 1000 SL/TL machines to play digitized sounds. I do hope he doesn't mind me borrowing his DeskMate .SND file structure information, but I am new at this file distribution thing. ---------------------------------------- DeskMate .SND file structure thanks to: /* Sound Off! /* Written by Christopher Taveres /* Copyright (c) January 1992 /* Falsoft, Inc. /* PCM ---------------------------------------- This program is 100% public domain. Use it as you will, play with the source code, use the source code, and even ask money for your revised versions of it! Just give me a BIG THANKS and, if you don't wish to FREELY distribute YOUR source code, -please- make it available for others for a SMALL fee. Thanks! --Kenneth Udut, age 20, 14-JAN-1993 [I second the above. - J.L. Hayes] P.S. - This is Ken on 24-JAN-1993. Creating a header in TP wasn't the answer, so I'm going to attempt to just write the bytes for the header directly. Wish me Luck! P.P.S. - Ken again, on the day before his birthday. It's 27-JAN-1993, and I *should* be going to work. I've decided to release this program *NOW*, in its current form. Needed improvements [According to Ken]: * DeskMate Interface (okay - wishful thinking, but if I can find someone with the SDK, I might ask them to do me a BIG favor!!! * Ability to cut off the old header, if one, before adding on the new header. [Provided for .wav files. - JLH] * Ability to switch back and forth between DIFFERENT sound file types, including DeskMate's, WAV files, etc. * Ability to decode Instrument files into their separate parts. [Snd2wav, included with this version, can do so. - JLH] If you like what you see, or don't like it, or think it needs BIG help, give me a call at (908) 241-6246, or write me a note at: Kenneth Udut 170 East Clay Avenue, Roselle Park, NJ USA 07204-2050 Internet: kudut@ritz.mordor.com PC-Link/America Online: K Udut CompuServe: INTERNET> kudut@ritz.mordor.com Delphi: IN%"kudut@ritz.mordor.com" If you're in New Jersey, and want to stop by my 'workshop', please do! I'll have a pot of tea or coffee waiting for you, and we can sit down and chat! (Just give me a call first or leave me a note! Thanks! :D ) --Ken, on January 27, 1993, day before 21st birthday! [I, not Ken, am responsible for any bugs introduced with version 2.00. Ken has not worked on this program in some time, but I will keep him current. I expect he will remain the clearinghouse for the various modifiers of his program. You can call me at (207) 866-7903, or write to me at: Jeffrey Hayes, 130 Forest Ave., Lot 1, Orono, Maine 04473 Internet: tvdog@delphi.com Delphi: tvdog Other systems: Use whatever method your system provides for sending Internet email. ... or you could just write to Ken and "rat me out." (!) -- J.L. Hayes, June 22, 1994 - never mind how old *I* am!] THIS IS THE STRUCTURE AS I RECEIVED IT. AS I KNOW -NOTHING- ABOUT C, THIS IS GOING TO BE A *BIT* OF A CHALLENGE, BUT, SINCE I DON'T KNOW MUCH ABOUT PASCAL EITHER, LIFE SHOULD BE A LITTLE SIMPLER! struct dmheader { /* Structure of the header block */ INT marker; /* Marker bytes - should be 00 1a */ CHAR note_count; /* Number of notes in instrument file */ CHAR inst_num; /* Instrument number */ CHAR inst_name[10]; /* Instrument name */ INT sample_rate; /* Sampling rate */ CHAR filler[16]; /* I don't know what this does */ unsigned long sample_size; /* Number of samples in file */ CHAR filler2[8]; /* More unknown space */ [Note: I've been able to puzzle out most of the unknown parts of the .snd header. See CONV2SND.DOC. - J.L. Hayes] *) {pseudo-program - 'cause it seems to help program development! [Pseudocode updated. - JLH] define deskmate sound header. start program. print_banner; (* glory lines *) IF 0 or >2 command_line_parameters THEN message1 ELSE IF 2 command_line_parameters THEN dm_soundfile := second_parameter IF dm_soundfile has no extension THEN append .snd ELSE dm_soundfile := first_parameter with .snd extension IF 1 or 2 command_line_parameters THEN BEGIN search for file given as first_parameter IF file doesn't exist THEN message2 input_file := first_parameter try to open dm_soundfile for writing IF output file invalid THEN message3 open input_file for reading IF .wav file THEN read sample_rate from .wav header read sample_size from .wav header read start_offset from .wav header ELSE ask user for sample_rate ask user for sound_name IF NOT .wav file THEN sample_size := file length start_offset := 0 add header to beginning of dm_soundfile seek to start_offset in input_file add sample_size bytes from input_file to dm_soundfile close input_file close dm_soundfile report success or failure in operation; say our goodbyes; print_end_banner; print_banner: WRITELN('xxx program by Kenneth Udut'); message1: WRITELN('You must specify xxx arguments'); print_end_banner; message2: WRITELN('file xxx doesn't exist'); print_end_banner; message3: WRITELN('file xxx can't be created'); print_end_banner; print_end_banner: WRITELN('write the author xxxxxx'); halt; END. } (* THE REAL PROGRAM NOW FOLKS!!! HOLD ON TO YOUR HATS! *) (***********************************************************************) (***********************************************************************) PROGRAM DM_Sound_Cnv; CONST z = CHR(0); {saves typing, 24-JAN-1993} TYPE STRING3 = STRING[3]; {for file extensions} VAR is_wav : Boolean; {True if .wav header found} start_offset: longint; {offset in input file of start of sound data} sample_size : longint; {number of samples} sample_rate : BYTE; {merely carries indication of which rate it is} sound_name : string[9]; {Name that appears in DeskMate SOUND.PDM} human_name : string; {for silliness.} dm_soundfile: string; {output sound file} (***********************************************************************) PROCEDURE start_banner; BEGIN (* start_banner *) WRITELN('CONV2SND - Version 2.00, by Kenneth Udut,', ' - Public Domain'); WRITELN('(Modified by J.L. Hayes, 6/22/1994)' ); WRITELN(' Converts "other" digitized sound ', 'formats to DeskMate .SND format'); WRITELN(' for use with the DeskMate SOUND.PDM ', 'program for editing purposes!'); WRITELN; WRITELN(' Syntax: CONV2SND ROCKY.VOC, ', 'where ROCKY.VOC is *any* digitized sound'); WRITELN('_______________________________________', '________________________________________'); END; (* start_banner *) (***********************************************************************) PROCEDURE end_banner; BEGIN (* end_banner *) WRITELN('____________________________________', '___________________________________________'); WRITELN('Catch ya later, my friend! Drop me a note, ', human_name,' - I promise I''ll reply!'); WRITELN; WRITELN('Kenneth Udut, 170 East Clay Avenue, ', 'Roselle Park, NJ 07204-2050'); WRITE('kudut@ritz.mordor.com 908/241-6246 February 3, 1993'); halt; END; (* end_banner *) (***********************************************************************) FUNCTION lastpos(st: STRING; ch: char): integer; { Returns the position of the last occurrence of ch in st, 0 if not present. } VAR i: integer; place: integer; BEGIN (* lastpos *) i := length(st); place := 0; WHILE (i > 0) AND (place = 0) DO BEGIN IF st[i] = ch THEN place := i; i := i - 1; END; (* while *) lastpos := place; END; (* lastpos *) (***********************************************************************) FUNCTION has_extension(st: STRING): Boolean; { Returns True if filename st has an extension. } VAR dotplace: integer; (* last position of '.' in st *) slashplace: integer; (* last position of '\' in st *) colonplace: integer; (* last position of ':' in st *) BEGIN (* has_extension *) slashplace := lastpos(st, '\'); colonplace := lastpos(st, ':'); IF colonplace > slashplace THEN slashplace := colonplace; IF slashplace <> 0 THEN delete(st, 1, slashplace); dotplace := lastpos(st, '.'); IF dotplace = 0 THEN has_extension := False ELSE has_extension := (dotplace >= length(st)-3); END; (* has_extension *) (***********************************************************************) FUNCTION set_extension(st: STRING; ext: STRING3): STRING; { Sets the extension of filename st to ext and returns the result. } VAR dotplace: integer; (* last position of '.' in st *) slashplace: integer; (* last position of '\' in st *) colonplace: integer; (* last position of ':' in st *) pathname: STRING; (* drive and path, excluding filename *) filename: STRING; (* filename, excluding drive and path *) BEGIN (* set_extension *) slashplace := lastpos(st, '\'); colonplace := lastpos(st, ':'); IF colonplace > slashplace THEN slashplace := colonplace; IF slashplace = 0 THEN pathname := '' ELSE BEGIN pathname := copy(st, 1, slashplace); delete(st, 1, slashplace); END; filename := st; dotplace := lastpos(filename, '.'); IF dotplace = 0 THEN filename := filename + '.' + ext ELSE filename := copy(filename, 1, dotplace) + ext; set_extension := pathname + filename; END; (* set_extension *) (***********************************************************************) PROCEDURE check_command_line; (* This procedure has been modified in version 2.00 to allow the user to specify the output file, and to make the output file name default to the input file name, plus an .snd extension. *) VAR dotpos : integer; (* position of "." in input filename *) BEGIN (* check_command_line *) IF (ParamCount = 0) or (ParamCount > 2) THEN BEGIN WRITELN('You have specified either NO filenames, TOO MANY filenames, ', 'or tried switches.'); WRITELN('This program only asks for one or two filenames, so all you ', 'need to do is the'); WRITELN('following. If the sound file you wish to convert is called ', 'BULLWINK, simply'); WRITELN('type one of these:'); WRITELN; WRITELN(' CONV2SND BULLWINK [or] CONV2SND BULLWINK ', 'FOO'); WRITELN; WRITELN('The sound in BULLWINK will be converted to DeskMate .SND ', 'form. In the first'); WRITELN('case, the new file will be named BULLWINK.SND; in the ', 'second case, the file'); WRITELN('will be named FOO.SND. (See Conv2snd.doc for details.)' ); WRITELN; WRITELN('NOTE: You must have free space on your disk for the new file.'); end_banner END; (* if ParamCount = 0 or ParamCount > 2 *) (* Number of parameters OK. Set output filename. *) IF (ParamCount = 2) THEN BEGIN (* output file specified on command line *) dm_soundfile := ParamStr(2); IF NOT has_extension(dm_soundfile) THEN dm_soundfile := set_extension(dm_soundfile, 'snd'); END ELSE BEGIN (* output file not specified, defaults to input + .snd *) dm_soundfile := ParamStr(1); dm_soundfile := set_extension(dm_soundfile, 'snd'); END; (* else if ParamCount <> 2 *) END; (* check_command_line *) (***********************************************************************) PROCEDURE not_here; BEGIN (* not_here *) WRITELN; WRITELN('The input file you specified, "',ParamStr(1), '", doesn''t seem to be present.'); WRITELN('Please check your spelling, maybe do a DIR/W ', 'a couple of times, fiddle'); WRITELN('around a wee bit and give it another shot };-> '); WRITELN; WRITELN('adonis_note: Time is a great teacher, ', 'but unfortunately kills all its pupils.'); end_banner; END; (* not_here *) (***********************************************************************) PROCEDURE bad_output; (* This procedure is called when the output file cannot be created. *) BEGIN (* bad_output *) WRITELN; WRITELN('The output file you specified, "',dm_soundfile,'", could not'); WRITELN('be created. Enter a valid filename for the output file, ', 'or leave blank'); WRITELN('to use the default.'); end_banner; END; (* bad_output *) (***********************************************************************) PROCEDURE full_disk; (* This procedure is called when a full disk is detected when writing to the output file. *) BEGIN (* full_disk *) WRITELN; WRITELN('The disk where the output file goes is full! File "', dm_soundfile,'"'); WRITELN('has been erased. Try again, specifying a file on a drive ', 'with more space'); WRITELN('as the output file.'); end_banner; END; (* full_disk *) (***********************************************************************) (****************** WISH ME LUCK *********************) (* *) (* This is the portion where I attempt to convert a *) (* regular sound file into an extra-special DESKMATE *) (* SND FILE! It's the last part of the program for *) (* me to write, as I was having too much fun procras *) (* tinating, making up the text and such! *) (* *) (*****************************************************) PROCEDURE convert_file; VAR old_snd_file : FILE; new_snd_file : FILE; header : array [0..43] of byte; wordrate : ^word; sampsize : ^longint; i : INTEGER; bytesdone : longint; {number of bytes copied to output file} thistime : longint; {number of bytes done in 1 pass of copy loop} NumRead, NumWritten: Word; {for BLOCKREAD and BLOCKWRITE} buf: array[1..2048] of Char; BEGIN (* convert_file *) (* Prepare input file for reading and determine number of samples. *) ASSIGN(old_snd_file, ParamStr(1)); RESET(old_snd_file, 1); (* The following two lines were added in v. 2.00 to provide for .wav files. - JLH *) SEEK(old_snd_file, start_offset); IF NOT is_wav THEN (* added in v. 2.00 *) sample_size := FileSize(old_snd_file); WRITELN; WRITELN('Hey, ',human_name,'? ',paramstr(1), ' contains ', sample_size,' samples.'); WRITELN; (* Construct .snd header. Ken tried to do it this way but couldn't get it to work. This code is new in v. 2.00. *) FOR i := 0 to 43 DO header[i] := 0; header[0] := $1A; header[2] := 1; FOR i := 1 to length(sound_name) DO header[i+3] := byte(sound_name[i]); wordrate := @header[$0E]; wordrate^ := 5500 SHL (sample_rate-1); header[$10] := $FF; header[$12] := $FF; header[$13] := $FF; header[$14] := $2C; (* add initial offset field, new for v.2 *) sampsize := @header[$20]; sampsize^ := sample_size; (* Create output file and write header. *) ASSIGN(new_snd_file, dm_soundfile); REWRITE(new_snd_file, 1); BLOCKWRITE(new_snd_file, header, 44); (* Announce success (optimistic, aren't we?). *) WRITELN('All Important 44 byte header portion successfully written to ', dm_soundfile,'!'); WRITELN; WRITELN('Now adding old digitized sound file to new, ', 'DeskMate format sound file.'); WRITELN('Each ">" equals 2048 sound bytes.'); (* The loop below has been changed from an EOF loop in v. 1.98 to a loop that copies sample_size bytes. The length of the data block from the .wav header, if present, will be used by v. 2.00 to set sample_size. This enables skipping over junk at the end of a .wav file, such as is attached by Goldwave. EOF, specifically premature EOF, still needs to be detected, though, to avoid an infinite loop. - JLH *) bytesdone := 0; (* number of bytes copied so far *) thistime := 0; (* number of bytes to copy this pass *) NumRead := 0; (* used to detect premature EOF *) WHILE (bytesdone < sample_size) AND (NumRead = thistime) DO BEGIN thistime := sample_size - bytesdone; IF thistime > SizeOf(buf) THEN thistime := SizeOf(buf); BLOCKREAD(old_snd_file,buf, word(thistime),NumRead); BLOCKWRITE(new_snd_file,buf,NumRead,NumWritten); (* Lines below to detect a full disk added in version 2.00 *) IF (NumWritten <> NumRead) THEN BEGIN WRITELN; CLOSE(old_snd_file); (* close both files *) CLOSE(new_snd_file); ERASE(new_snd_file); (* erase the incomplete output file *) (* display error message to the user and halt the program *) full_disk; END; (* if NumWritten <> NumRead *) bytesdone := bytesdone + NumWritten; WRITE('>'); END; (* while bytesdone < sample_size *) (* If premature EOF occurred while copying, go back and change the header on the output file to match the actual number of samples read from the input file. - JLH *) IF bytesdone < sample_size THEN BEGIN WRITELN; WRITELN('The length of the input .wav file does not match ', 'its .wav header. Its true'); WRITELN('length is ', bytesdone, '.' ); WRITELN; WRITELN('Adjusting the .snd header of the output file ', 'to compensate ...'); SEEK(new_snd_file, 32); BLOCKWRITE(new_snd_file, bytesdone, 4); SEEK(new_snd_file, filesize(new_snd_file)); END; (* if bytesdone < sample_size *) (* close both files *) WRITELN; CLOSE(old_snd_file); CLOSE(new_snd_file); WRITELN; WRITELN('Safely closing ',ParamStr(1), ' and ',dm_soundfile,'.'); END; (* convert_file *) (***********************************************************************) PROCEDURE ask_questions; {02-FEB-93 - for sample rate} VAR inchar : char; {for reading sampling rate, avoids "Runtime error 106"} BEGIN (* ask_questions *) sound_name := ''; human_name := ''; WRITELN; WRITELN('______Q_U_E_S_T_I_O_N_S______'); WRITELN(' ', '_________________________________ '); IF NOT is_wav THEN BEGIN WRITELN('A) Select Sampling Rate. ', '/ Sample Rate is an indication of \'); WRITELN(' ', '\ the rate at which SOUND.PDM or /'); WRITELN(' 1) 5500 - ''speech'' ', '/ or other DeskMate .SND players \'); WRITELN(' 2) 11000 - ''usual recordings'' ', '\ reads and plays back the sound /'); WRITELN(' 3) 22000 - ''hi-quality / Mac'' ', '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '); WRITELN; WRITE(CHR(7)); sample_rate := 0; WHILE (sample_rate < 1) OR (sample_rate > 3) DO BEGIN WRITE('Please Select 1, 2, or 3. > '); READLN(inchar); sample_rate := ord(inchar) - ord('0'); END; (* while *) WRITELN; WRITELN; WRITELN(' ', '_________________________________ '); END; (* if not is_wav *) WRITELN('B) Select Name of Sound ', '/ "Name of Sound" *isn''t* the name\'); WRITELN(' 9 Characters or Less ', '\ of the file being created. It /'); WRITELN(' ', '/ It is the name that appears \'); WRITELN(' Example: Disgusting or ', '\ in SOUND.PDM next to "Name:" /'); WRITELN(' Eastwood ', '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '); WRITE(CHR(7)); (* Note: version 1.98 required the user to enter a sound name. In this version, a null name will be used if none is entered. - JLH *) WRITE('Name / Description of Sound (9 Characters or Less) > '); READLN(sound_name); (* It is no longer necessary to pad the string out to its full length, as was done in earlier versions. - JLH *) WRITELN; WRITELN; WRITELN('C) Oh, and by the way ...'); WRITELN(' My name is Ken. What''s your name?'); WRITELN; WRITE(CHR(7)); (* Note: version 1.98 required the user to enter his or her name. In this version, a default name of "CONV2SND user" will be used if none is entered. - JLH *) WRITE('Your Name? > '); READLN(human_name); IF (human_name = '') THEN human_name := 'CONV2SND user'; WRITELN; WRITELN('Thanks for answering my questions! Now, ',human_name, ', here goes CONV2SND!!!'); WRITELN; END; (* ask_questions *) (***********************************************************************) FUNCTION FileExists(FileName: STRING): Boolean; { Returns True IF file exists; otherwise, it returns False. } VAR f : file; BEGIN (* FileExists *) {$I-} ASSIGN(f, FileName); RESET(f); CLOSE(f); {$I+} FileExists := (IOResult = 0) and (FileName <> ''); END; (* FileExists *) (***********************************************************************) FUNCTION CanCreate(FileName: STRING): Boolean; { This function does for the output file what FileExists does for the input file. Returns True if the file can be created, False otherwise. } VAR f : file; result: Boolean; BEGIN (* CanCreate *) {$I-} ASSIGN(f, FileName); REWRITE(f); result := (IOResult = 0); {$I+} IF result THEN BEGIN CLOSE(f); ERASE(f); END; (* if result *) CanCreate := result; END; (* CanCreate *) (***********************************************************************) PROCEDURE check_wav; (* This procedure checks for a valid RIFF WAVE header on the input file and sets the start of sound data, the length of the sound data, and the sampling rate according to the header, if present. It also displays an appropriate message to the user if the .wav is of a type that can't be converted directly by CONV2SND. *) (* Labels to jump to in case of errors. Yeah, yeah, I *know* about "Never use GOTO!", but I wouldn't want to see what this routine would look like without it. *) LABEL 100, 200, 300, 400; VAR (* Input file, untyped so we can treat it as a bytestream, like in C. *) f : FILE; (* Label for chunks in the .wav file. *) chunklabel : packed array [0..3] of char; (* Number of bytes successfully read by BLOCKREAD. *) bytesread : word; (* Target of seek operation on the input file. *) seekpoint : longint; (* Size of the input file in bytes, to make sure we don't try to seek past the end of it. *) fsize : longint; (* do_format sets this to True if there is an error in the format chunk, but the user opts to ignore the header and continue anyway. *) fmt_error : Boolean; (* This is set to true when a format chunk has been found. We have to make sure that there is a format chunk in the file before the data chunk. *) fmt_found : Boolean; (* When the user is asked a "yes" or "no" question, getyn puts the answer here. *) answer : char; (* The size of a chunk, as read from the file. The size of the data chunk is the number of samples in the file, provided they are mono 8-bit. *) blocksize : longint; (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*) PROCEDURE getyn; (* This procedure gets a "yes" or "no" answer from the user. *) BEGIN (* getyn *) REPEAT answer := 'q'; WRITE('Enter Y or N. > '); READLN(answer); answer := UpCase(answer); UNTIL (answer = 'Y') or (answer = 'N'); END; (* getyn *) (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*) PROCEDURE do_format( VAR fmt_error: Boolean ); (* This procedure reads the format chunk from the .wav file, verifies that the .wav is of a type that can be converted, and sets the sampling rate. If an invalid format is detected, the user is asked if he wants to continue. If not, the program is terminated. If so, fmt_error is set to True and the procedure returns. If the format is valid but of an unsupported type, do_format provides instructions on how to fix the file and exits the program. *) VAR (* 16-byte Microsoft PCM format chunk *) fmtchunk: RECORD tag : word; (* format tag, must be 1 *) nchannels : word; (* number of channels, 1 = mono *) rate : longint; (* sampling rate in Hz *) bytespersec : longint; (* not used *) bytespersamp: word; (* not used *) size : word; (* sample size in bits *) END; (* record *) BEGIN (* do_format *) (* Start out optimistic. *) fmt_error := False; (* If the format chunk is not 16 bytes long, it's not Microsoft PCM, or it's not a valid format. *) IF blocksize <> 16 THEN BEGIN WRITELN('The .wav format type is unknown or invalid. ', 'Do you want to ignore the header'); WRITELN('and go on?'); getyn; IF answer = 'N' THEN BEGIN CLOSE(f); end_banner; END; fmt_error := True; exit; END; (* if blocksize <> 16 *) (* Read in the format chunk. *) BLOCKREAD(f, fmtchunk, 16, bytesread); IF bytesread < 16 THEN BEGIN WRITELN('End of file encountered while reading .wav header. ', 'The file is probably'); WRITELN('corrupt. Do you want to ignore the header and go on?'); getyn; IF answer = 'N' THEN BEGIN CLOSE(f); end_banner; END; fmt_error := True; exit; END; (* if bytesread < 16 *) (* Verify the format tag. *) IF fmtchunk.tag <> 1 THEN BEGIN WRITELN('The .wav format type is unknown or invalid. ', 'Do you want to ignore the header'); WRITELN('and go on?'); getyn; IF answer = 'N' THEN BEGIN CLOSE(f); end_banner; END; fmt_error := True; exit; END; (* if fmtchunk.tag <> 1 *) (* Verify the number of channels. *) IF fmtchunk.nchannels <> 1 THEN BEGIN WRITELN(ParamStr(1),' has ',fmtchunk.nchannels,' channels.'); WRITELN('CONV2SND can only convert mono .wav''s directly. You ', 'can use Ppwav to mix the'); WRITELN('.wav to mono so that CONV2SND can convert it to .snd.'); CLOSE(f); end_banner; END; (* if more than 1 channel *) (* Convert the sampling rate to the byte code needed by convert_file. *) IF (fmtchunk.rate >= 0.95*5500) and (fmtchunk.rate <= 1.05*5500) THEN sample_rate := 1 ELSE IF (fmtchunk.rate >= 0.95*11000) and (fmtchunk.rate <= 1.05*11000) THEN sample_rate := 2 ELSE IF (fmtchunk.rate >= 0.95*22000) and (fmtchunk.rate <= 1.05*22000) THEN sample_rate := 3 ELSE IF (fmtchunk.rate >= 0.95*44000) and (fmtchunk.rate <= 1.05*44000) THEN BEGIN WRITELN(ParamStr(1),' has a sampling rate of ',fmtchunk.rate,'.'); WRITELN('Use Ppwav to cut its rate in half and try again.'); CLOSE(f); end_banner; END (* rate near 44kHz *) ELSE BEGIN WRITELN(ParamStr(1),' has a sampling rate of ',fmtchunk.rate,'.'); WRITELN('You will have to use Sox or a similar program to ', 'resample the sound before'); WRITELN('converting it to .snd. Sound.pdm only supports 5500, ', '11000, and 22000 as'); WRITELN('sampling rates. You should resample the sound to one ', 'of those.'); CLOSE(f); end_banner; END; (* sample rate not supported *) (* Verify 8-bit samples. *) IF fmtchunk.size > 8 THEN BEGIN WRITELN(ParamStr(1),' has ',fmtchunk.size,'-bit samples.'); WRITELN('The Tandy sound chip uses 8-bit samples. Use Ppwav to ', 'convert the file to'); WRITELN('8-bit samples and try again.'); CLOSE(f); end_banner; END; (* samples not 8-bit *) END; (* do_format *) (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*) BEGIN (* check_wav *) (* Initially, assume it's not a .wav. *) is_wav := False; start_offset := 0; (* Open the input file as an "untyped" file and get file size. *) ASSIGN(f, ParamStr(1)); RESET(f, 1); fsize := FileSize(f); (* Read in "RIFF" header, if present. *) BLOCKREAD(f, chunklabel, 4, bytesread); IF (bytesread < 4) or (chunklabel <> 'RIFF') THEN goto 100; (* Read in "WAVE" header, if present. *) seekpoint := FilePos(f) + 4; IF seekpoint >= fsize THEN goto 100; SEEK(f, seekpoint); BLOCKREAD(f, chunklabel, 4, bytesread); IF (bytesread < 4) or (chunklabel <> 'WAVE') THEN goto 100; (* Announce header found. *) WRITELN('RIFF WAVE header found. Checking format ...'); (* Loop over chunks until data chunk found or end of file. *) fmt_found := False; REPEAT (* Read the chunk label and length. *) BLOCKREAD(f, chunklabel, 4, bytesread); IF bytesread < 4 THEN goto 200; BLOCKREAD(f, blocksize, 4, bytesread); IF bytesread < 4 THEN goto 200; (* If this is a format chunk, make sure we haven't already seen one before, take note of the fact that we've seen one *now*, and call do_format to check out the format. *) IF chunklabel = 'fmt ' THEN BEGIN IF fmt_found THEN goto 300; fmt_found := True; do_format(fmt_error); IF fmt_error THEN goto 100; END (* if chunklabel = 'fmt ' *) (* If this is neither a format chunk nor a data chunk, skip it. *) ELSE IF chunklabel <> 'data' THEN BEGIN seekpoint := FilePos(f) + blocksize; IF seekpoint > fsize THEN goto 200; SEEK(f, seekpoint); END; (* else if chunklabel <> 'data' *) UNTIL chunklabel = 'data'; (* Data chunk found. Make sure that we saw a format chunk first. *) IF NOT fmt_found THEN goto 400; (* Everything is fine. do_format has set sample_rate. Set is_wav to True, record the point in the input file where the sound data begins, and note the number of samples. *) is_wav := True; start_offset := FilePos(f); sample_size := blocksize; (* Tell the user we succeeded, close the file, and exit. *) WRITELN('Format OK!'); CLOSE(f); exit; (* Jump to here if .wav header not present, or if do_format indicated that the format is erroneous. *) 100: CLOSE(f); exit; (* Jump to here on EOF while reading .wav header. *) 200: CLOSE(f); WRITELN('End of file encountered while reading .wav header. ', 'The file is probably'); WRITELN('corrupt. Do you want to ignore the header and go on?'); getyn; IF answer = 'N' THEN end_banner; exit; (* Jump to here if more than one format chunk. *) 300: CLOSE(f); WRITELN('There is more than one format chunk in the .wav header. ', 'The file is probably'); WRITELN('corrupt. Do you want to ignore the header and go on?'); getyn; IF answer = 'N' THEN end_banner; exit; (* Jump to here if no format chunk. *) 400: CLOSE(f); WRITELN('There is no format chunk in the .wav header. The file is ', 'probably corrupt.'); WRITELN('Do you want to ignore the header and go on?'); getyn; IF answer = 'N' THEN end_banner; exit; END; (* check_wav *) (***********************************************************************) BEGIN (* Conv2snd *) start_banner; {the user is assigned a name here, in case something happens early on} human_name := 'CONV2SND user'; {if a problem occurs, it's taken care of in this procedure:} check_command_line; IF not FileExists(paramstr(1)) THEN not_here; IF not CanCreate(dm_soundfile) THEN bad_output; check_wav; ask_questions; convert_file; WRITELN(paramstr(1),' has been successfully converted into a ', 'DeskMate Sound file'); WRITELN('100% editable by DeskMate''s Sound Editor!!! Congratulations, ', human_name,'!!!'); WRITELN; WRITELN('adonis_note: Life is a funny game ... ', 'some people play ... some people main'); WRITELN(' (beginning of a famous poem, ', 'spoken to me by my Tandy 1000 TL'); WRITELN; end_banner; END. (* Conv2snd *)